{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit NameValues;

interface

uses Classes;

type
  TAHMNameValueList = class
  private
    FNames: TStringList;
    FValues: TStringList;
    FParent: TAHMNameValueList;
  protected
    function GetCount: Integer;
    function GetText: String;
    function GetNameProp(Index: Integer): String;
    function GetValueProp(Index: Integer): String;
    function GetObjectProp(Index: Integer): TObject;
    procedure SetValueProp(Index: Integer; Value: String);
    procedure SetObjectProp(Index: Integer; Value: TObject);
  public
    constructor Create;
    destructor Destroy; override;
    property Count: Integer read GetCount;
    property Text: String read GetText;
    property Names[Index: Integer]: String read GetNameProp; default;
    property Values[Index: Integer]: String read GetValueProp write SetValueProp;
    property Objects[Index: Integer]: TObject read GetObjectProp write SetObjectProp;
    property Parent: TAHMNameValueList read FParent write FParent;
    function IndexOf(const Name: String): Integer;
    function GetValue(const Name: String): String;
    function GetObject(const Name: String): TObject;
    function AddValue(const Name, Value: String): Integer; overload; virtual;
    function AddObject(const Name: String; Value: TObject): Integer; virtual;
    procedure Clear; virtual;
    procedure Delete(Index: Integer); virtual;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure WriteNames(Strings: TStrings);
    procedure WriteValues(Strings: TStrings);
    procedure Assign(Source: TAHMNameValueList);
  end;

implementation

constructor TAHMNameValueList.Create;
begin
  inherited;

  // We'd like the name list to be sorted with no duplicate entries
  FNames := TStringList.Create;
  FNames.Duplicates := dupIgnore;
  FNames.CaseSensitive := False;
  FNames.Sorted := True;

  // Value list isn't sorted, but needs to be one based so we add dummy entry
  FValues := TStringList.Create;
  FValues.Add('dummy');
end;

destructor TAHMNameValueList.Destroy;
begin
  FNames.Free;
  FValues.Free;

  inherited Destroy;
end;

function TAHMNameValueList.GetCount: Integer;
begin
  Result := FNames.Count;
end;

function TAHMNameValueList.GetText: String;
var
  i: Integer;
begin
  Result := '';

  // Concatenate all name value pairs with linefeed separator
  for i := 0 to Pred(FNames.Count) do
    Result := Result + FNames[i] + '=' + FValues[Integer(FNames.Objects[i])] + sLineBreak;
end;

function TAHMNameValueList.GetNameProp(Index: Integer): String;
begin
  Result := FNames[Index];
end;

function TAHMNameValueList.GetValueProp(Index: Integer): String;
var
  i: Integer;
begin
  // Get value index for specified item
  i := Integer(FNames.Objects[Index]);

  if i > 0 then Result := FValues[i]
           else Result := '';
end;

function TAHMNameValueList.GetObjectProp(Index: Integer): TObject;
var
  i: Integer;
begin
  // Get value index for specified item
  i := Integer(FNames.Objects[Index]);

  if i > 0 then Result := FValues.Objects[i]
           else Result := nil;
end;

procedure TAHMNameValueList.SetValueProp(Index: Integer; Value: String);
var
  i: Integer;
begin
  // Get value index for specified item
  i := Integer(FNames.Objects[Index]);
  if i > 0 then FValues[i] := Value;
end;

procedure TAHMNameValueList.SetObjectProp(Index: Integer; Value: TObject);
var
  i: Integer;
begin
  // Get value index for specified item
  i := Integer(FNames.Objects[Index]);
  if i > 0 then FValues.Objects[i] := Value;
end;

function TAHMNameValueList.IndexOf(const Name: String): Integer;
begin
  Result := FNames.IndexOf(Name);
end;

function TAHMNameValueList.GetValue(const Name: String): String;
var
  i: Integer;
begin
  // Locate name in names list and extract value index
  i := FNames.IndexOf(Name);

  if i < 0 then
    Result := ''
  else
    Result := FValues[Integer(FNames.Objects[i])];
end;

function TAHMNameValueList.GetObject(const Name: String): TObject;
var
  i: Integer;
begin
  // Locate name in names list and extract value index
  i := FNames.IndexOf(Name);

  if i < 0 then
    Result := nil
  else
    Result := FValues.Objects[Integer(FNames.Objects[i])];
end;

function TAHMNameValueList.AddValue(const Name, Value: String): Integer;
var
  i: Integer;
begin
  // First get index of added name
  Result := FNames.Add(Name);
  i := Integer(FNames.Objects[Result]);

  // If this item is new then add to value list, otherwise update value
  if i > 0 then
    FValues[i] := Value
  else
    FNames.Objects[Result] := TObject(FValues.Add(Value));
end;

function TAHMNameValueList.AddObject(const Name: String; Value: TObject): Integer;
var
  i: Integer;
begin
  // First get index of added name
  Result := FNames.Add(Name);
  i := Integer(FNames.Objects[Result]);

  // If this item is new then add to value list, otherwise update value
  if i > 0 then
    FValues.Objects[i] := Value
  else
    FNames.Objects[Result] := TObject(FValues.AddObject('', Value));
end;

procedure TAHMNameValueList.Clear;
begin
  FNames.Clear;
  FValues.Clear;
  FValues.Add('dummy'); // Keep values one based
end;

procedure TAHMNameValueList.Delete(Index: Integer);
begin
  // Delete name only, as we can't re-order our values (leaves orphan value)
  FNames.Delete(Index);
end;

procedure TAHMNameValueList.BeginUpdate;
begin
  // Temporarily switch off sorting of our names list
  FNames.BeginUpdate;
  FNames.Sorted := False;
  FValues.BeginUpdate;
end;

procedure TAHMNameValueList.EndUpdate;
begin
  // Re-sort name list including our new items
  FNames.Sorted := True;
  FNames.EndUpdate;
  FValues.EndUpdate;
end;

procedure TAHMNameValueList.WriteNames(Strings: TStrings);
var
  i: Integer;
begin
  if Assigned(Strings) then
  begin
    Strings.BeginUpdate;
    try
      for i := 0 to Pred(FNames.Count) do
        Strings.Add(FNames[i]);
    finally
      Strings.EndUpdate;
    end;
  end;
end;

procedure TAHMNameValueList.WriteValues(Strings: TStrings);
var
  i: Integer;
begin
  if Assigned(Strings) then
  begin
    Strings.BeginUpdate;
    try
      for i := 0 to Pred(FNames.Count) do
        Strings.Add(FNames[i] + '=' + GetValueProp(i));
    finally
      Strings.EndUpdate;
    end;
  end;
end;

procedure TAHMNameValueList.Assign(Source: TAHMNameValueList);
begin
  if Assigned(Source) then
  begin
    FNames.Assign(Source.FNames);
    FValues.Assign(Source.FValues);
  end
  else
    Clear;
end;


end.
